En esta práctica se elabora un caso práctico orientado a aprender a identificar los datos relevantes para un proyecto analítico y usar las herramientas de integración, limpieza, validación y análisis de los mismos.
● Aprender a aplicar los conocimientos adquiridos y su capacidad de resolución de problemas en entornos nuevos o poco conocidos dentro de contextos más amplios o multidisciplinares. ● Saber identificar los datos relevantes y los tratamientos necesarios (integración, limpieza y validación) para llevar a cabo un proyecto analítico. ● Aprender a analizar los datos adecuadamente para abordar la información contenida en los datos. ● Identificar la mejor representación de los resultados para aportar conclusiones sobre el problema planteado en el proceso analítico. ● Actuar con los principios éticos y legales relacionados con la manipulación de datos en función del ámbito de aplicación. ● Desarrollar las habilidades de aprendizaje que les permitan continuar estudiando de un modo que tendrá que ser en gran medida autodirigido o autónomo. ● Desarrollar la capacidad de búsqueda, gestión y uso de información y recursos en el ámbito de la ciencia de datos.
Primero cargamos las librerías que vamos a usar durante la práctica
if (!require('dplyr')) install.packages('dplyr');library(dplyr)
## Loading required package: dplyr
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
if (!require('ggplot2')) install.packages('ggplot2');library(ggplot2)
## Loading required package: ggplot2
if (!require('reshape')) install.packages('reshape');library(reshape)
## Loading required package: reshape
##
## Attaching package: 'reshape'
## The following object is masked from 'package:dplyr':
##
## rename
if (!require('plotly')) install.packages('plotly');library(plotly)
## Loading required package: plotly
##
## Attaching package: 'plotly'
## The following object is masked from 'package:reshape':
##
## rename
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
if (!require('plyr')) install.packages('plyr');library(plyr)
## Loading required package: plyr
## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
##
## Attaching package: 'plyr'
## The following objects are masked from 'package:plotly':
##
## arrange, mutate, rename, summarise
## The following objects are masked from 'package:reshape':
##
## rename, round_any
## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize
if (!require('Stat2Data')) install.packages('Stat2Data');library(Stat2Data)
## Loading required package: Stat2Data
if (!require('corrplot')) install.packages('corrplot');library(corrplot)
## Loading required package: corrplot
## corrplot 0.92 loaded
if (!require('Matrix')) install.packages('matrix');library(Matrix)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following object is masked from 'package:reshape':
##
## expand
if (!require('patchwork')) install.packages('patchwork');library(patchwork)
## Loading required package: patchwork
if (!require('ggcorrplot')) install.packages('ggcorrplot');library(ggcorrplot)
## Loading required package: ggcorrplot
Puede ser el resultado de adicionar diferentes datasets o una subselección útil de los datos originales, en base al objetivo que se quiera conseguir.
Primero de todo, realizamos la descripción de las variables que hay en el dataset “Heart Attack Analysis & Prediction dataset”, usando la información encontrada en la web [Kaggle datasets] (https://www.kaggle.com/datasets), concretamente en el siguiente enlace: https://www.kaggle.com/datasets/rashikrahmanpritom/heart-attack-analysis-predictiondataset
Cargamos los datos de la base de datos “heart” y tipificamos las variables que tiene el conjunto de datos como corresponde
library(readxl)
heart <- read_excel("~/Documents/AAESTUDIOS/UOC_Máster_Data_Science/4t_Semestre/Tipologia_Ciclodevida_datos/PR2/heart.xlsx")
View(heart)
# Mostramos los primeros registros del conjunto de dtos, con el fin de ver una aproximación de como es el conjunto y su estructura
head(heart)
## # A tibble: 6 × 14
## age sex cp trtbps chol fbs restecg thalachh exng oldpeak slp
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 63 1 3 145 233 1 0 150 0 2.3 0
## 2 37 1 2 130 250 0 1 187 0 3.5 0
## 3 41 0 1 130 204 0 0 172 0 1.4 2
## 4 56 1 1 120 236 0 1 178 0 0.8 2
## 5 57 0 0 120 354 0 1 163 1 0.6 2
## 6 57 1 0 140 192 0 1 148 0 0.4 1
## # ℹ 3 more variables: caa <dbl>, thall <dbl>, output <dbl>
str(heart)
## tibble [303 × 14] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:303] 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : num [1:303] 1 1 0 1 0 1 0 1 1 1 ...
## $ cp : num [1:303] 3 2 1 1 0 0 1 1 2 2 ...
## $ trtbps : num [1:303] 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : num [1:303] 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : num [1:303] 1 0 0 0 0 0 0 0 1 0 ...
## $ restecg : num [1:303] 0 1 0 1 1 1 0 1 1 1 ...
## $ thalachh: num [1:303] 150 187 172 178 163 148 153 173 162 174 ...
## $ exng : num [1:303] 0 0 0 0 1 0 0 0 0 0 ...
## $ oldpeak : num [1:303] 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slp : num [1:303] 0 0 2 2 2 1 1 2 2 2 ...
## $ caa : num [1:303] 0 0 0 0 0 0 0 0 0 0 ...
## $ thall : num [1:303] 1 2 2 2 2 1 2 3 3 2 ...
## $ output : num [1:303] 1 1 1 1 1 1 1 1 1 1 ...
# Definimos las variables como numericas o categóricas:
# Númericas
heart$age<-as.numeric(heart$age)
heart$trtbps<-as.numeric(heart$trtbps)
heart$chol<-as.numeric(heart$chol)
heart$thalachh<-as.numeric(heart$thalachh)
heart$oldpeak<-as.numeric(heart$oldpeak)
heart$caa<-as.numeric(heart$caa)
# Categóricas
heart$sex<-as.factor(heart$sex)
heart$cp<-as.factor(heart$cp)
heart$fbs<-as.factor(heart$fbs)
heart$restecg<-as.factor(heart$restecg)
heart$exng<-as.factor(heart$exng)
heart$slp<-as.factor(heart$slp)
heart$thall<-as.factor(heart$thall)
#Observamos las dimensiones del dataset "heart"
heart.cols<-dim(heart)[2]
heart.rows<-dim(heart)[1]
Podemos ver como el conjunto de datos heart tiene 14 atributos y 303 observaciones
# Creamos una nueva variable 'age_group' basada en la categoria de edad correspondiente
heart$age_group <- cut(heart$age, breaks = c(0, 30, 60, max(heart$age)), labels = c("Joven", "Adulto", "Mayor"))
# Ahora 'age_group' contiene categorías de edad en lugar de valores continuos
str(heart)
## tibble [303 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:303] 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 1 2 1 2 1 2 2 2 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 2 2 1 1 2 2 3 3 ...
## $ trtbps : num [1:303] 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : num [1:303] 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 1 1 1 1 1 1 1 2 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 1 2 2 2 1 2 2 2 ...
## $ thalachh : num [1:303] 150 187 172 178 163 148 153 173 162 174 ...
## $ exng : Factor w/ 2 levels "0","1": 1 1 1 1 2 1 1 1 1 1 ...
## $ oldpeak : num [1:303] 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slp : Factor w/ 3 levels "0","1","2": 1 1 3 3 3 2 2 3 3 3 ...
## $ caa : num [1:303] 0 0 0 0 0 0 0 0 0 0 ...
## $ thall : Factor w/ 4 levels "0","1","2","3": 2 3 3 3 3 2 3 4 4 3 ...
## $ output : num [1:303] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 2 2 2 2 2 2 ...
# Seleccionamos sólo los pacientes con presión arterial alta, ya que tienen un mayor riesgo
heart <- heart[heart$trtbps > 140, ]
str(heart)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 2 1 2 1 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 3 4 4 1 3 2 3 3 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 2 1 2 1 1 2 1 2 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 2 2 2 2 1 ...
## $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ exng : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 2 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
## $ slp : Factor w/ 3 levels "0","1","2": 1 3 3 3 1 3 2 3 3 1 ...
## $ caa : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
## $ thall : Factor w/ 4 levels "0","1","2","3": 2 4 3 3 3 3 3 3 3 3 ...
## $ output : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
Ahora vamos a visualizar la información básica del conjunto de datos
# La variable output nos va indicar quien tiene o no una enfermedad del corazón, por lo que primero calculamos el porcentaje de pacientes que tienen enfermedad del corazón y los que no:
print("Porcentaje de personas con enfermedad cardiovascular")
## [1] "Porcentaje de personas con enfermedad cardiovascular"
(sum(heart$output == 1)/nrow(heart))*100
## [1] 41.53846
# Vemos que el porcentaje de personas con una enfermedad cardiovascular es del 41,53%
print("Porcentaje de personas sin enfermedad cardiovascular")
## [1] "Porcentaje de personas sin enfermedad cardiovascular"
(sum(heart$output == 0)/nrow(heart))*100
## [1] 58.46154
# Vemos que el porcentaje de personas sin una enfermedad cardiovascular es del 58,46%
# A continuación estudiamos la estadística básica de las variables del conjunto, cargando el sumario de todos los atributos:
summary(heart)
## age sex cp trtbps chol fbs restecg
## Min. :40.00 0:22 0:33 Min. :142 Min. :126.0 0:50 0:38
## 1st Qu.:56.00 1:43 1: 5 1st Qu.:150 1st Qu.:225.0 1:15 1:26
## Median :59.00 2:16 Median :152 Median :244.0 2: 1
## Mean :59.25 3:11 Mean :157 Mean :249.9
## 3rd Qu.:65.00 3rd Qu.:160 3rd Qu.:282.0
## Max. :71.00 Max. :200 Max. :407.0
## thalachh exng oldpeak slp caa thall
## Min. : 88.0 0:41 Min. :0.000 0: 8 Min. :0.0000 0: 0
## 1st Qu.:128.0 1:24 1st Qu.:0.200 1:33 1st Qu.:0.0000 1: 7
## Median :147.0 Median :1.000 2:24 Median :0.0000 2:25
## Mean :144.3 Mean :1.392 Mean :0.8308 3:33
## 3rd Qu.:161.0 3rd Qu.:2.300 3rd Qu.:2.0000
## Max. :195.0 Max. :6.200 Max. :3.0000
## output age_group
## Min. :0.0000 Joven : 0
## 1st Qu.:0.0000 Adulto:37
## Median :0.0000 Mayor :28
## Mean :0.4154
## 3rd Qu.:1.0000
## Max. :1.0000
library(ggplot2)
# Edad (age)
summary(heart$age)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 40.00 56.00 59.00 59.25 65.00 71.00
g1<-ggplot(data=heart, aes(x=age))+
geom_density(color="darkblue", fill="blue") +
labs(title = "Edad de los pacientes", x="Edad", y= "Densidad")
g1
# Sexo (sex)
summary(heart$sex)
## 0 1
## 22 43
g2<-ggplot(data=heart, aes(x=sex))+
geom_bar(mapping = aes(x=sex, fill=sex)) +
labs(title = "Sexo de los pacientes", x="Sexo", y= "Recuento")
g2
# Dolor Torácico (cp)
summary(heart$cp)
## 0 1 2 3
## 33 5 16 11
g3<-ggplot(data=heart, aes(x=cp))+
geom_bar(aes(fill=cp)) +
facet_grid(~sex) +
labs(title = "Distribución del Dolor Torácico", x="Dolor Torácico", y= "Recuento")
g3
# Presión Arterial en Reposo (trtbps)
summary(heart$trtbps)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 142 150 152 157 160 200
g4<-ggplot(data=heart, aes(x=trtbps))+
geom_histogram(color="darkblue", fill="green") +
facet_grid(~sex) +
labs(title = "Distribución de la Presión Arterial en Reposo", x="Presión Arterial en Reposo (mm Hg)", y= "Recuento")
g4
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Colesterol Sérico
summary(heart$chol)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 126.0 225.0 244.0 249.9 282.0 407.0
g5<-ggplot(data=heart, aes(x=chol))+
geom_histogram(color="darkblue", fill="yellow") +
facet_grid(~sex) +
labs(title = "Distribución del Colesterol Sérico", x="Colesterol Sérico (mm/dl)", y= "Recuento")
g5
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Glucemia en ayunas (fbs)
summary(heart$fbs)
## 0 1
## 50 15
g6<-ggplot(data=heart, aes(x=fbs))+
geom_bar(fill="maroon4") +
facet_grid(~sex) +
labs(title = "Distribución Glucemia en ayunas > 120", x="Glucemia en Ayunas", y= "Recuento")
g6
# Electrocardiograma en Reposo (restecg)
summary(heart$restecg)
## 0 1 2
## 38 26 1
g7<-ggplot(data=heart, aes(x=restecg))+
geom_bar(aes(fill=restecg)) +
facet_grid(~sex) +
labs(title = "Distribución ECG en Reposo", x="ECG en Reposo", y= "Recuento")
g7
# Frecuencia Cardíaca Máxima (thalachh)
summary(heart$thalachh)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 88.0 128.0 147.0 144.3 161.0 195.0
g8<-ggplot(data=heart, aes(x=thalachh))+
geom_density(color="darkblue", fill="brown") +
facet_grid(~sex) +
labs(title = "Distribución Frecuencia Cardíaca Máxima alcanzada", x="Frecuencia Cardíaca Máxima", y= "Densidad")
g8
# Angina de Esfuerzo (exng)
summary(heart$exng)
## 0 1
## 41 24
g9<-ggplot(data=heart, aes(x=exng))+
geom_bar(aes(fill=exng)) +
facet_grid(~sex) +
labs(title = "Distribución Anginas Inducidas por Esfuerzo", x="Angina Inducida por Esfuerzo", y= "Recuento")
g9
# Antiguo pico (oldpeak)
summary(heart$oldpeak)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.200 1.000 1.392 2.300 6.200
g10<-ggplot(data=heart, aes(x=oldpeak))+
geom_histogram(color="black", fill="turquoise") +
facet_grid(~sex) +
labs(title = "Distribución Valor Medido en Depresión", x="Valor", y= "Recuento")
g10
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Pendiente del Segmento ST máximo (slp)
summary(heart$slp)
## 0 1 2
## 8 33 24
g11<-ggplot(data=heart, aes(x=slp))+
geom_bar(aes(fill=slp))+
facet_grid(~sex) +
labs(title = "Distribución Pendiente ST", x="Pendiente ST", y= "Recuento")
g11
# Número de grandes buques (caa)
summary(heart$caa)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.8308 2.0000 3.0000
g12<-ggplot(data=heart, aes(x=caa))+
geom_bar(fill="forestgreen")+
facet_grid(~sex) +
labs(title = "Distribución del Número de Buques", x="Nº de buques", y= "Recuento")
g12
# Tasa de Mortalidad (thall)
summary(heart$thall)
## 0 1 2 3
## 0 7 25 33
g13<-ggplot(data=heart, aes(x=thall))+
geom_bar(aes(fill=thall))+
facet_grid(~sex) +
labs(title = "Distribución de la Tasa de Mortalidad", x="Tasa de mortalidad", y= "Recuento")
g13
# Variable Cardiopatía (output)
summary(heart$output)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.4154 1.0000 1.0000
g14<-ggplot(data=heart, aes(x=output))+
geom_bar(fill="purple")+
facet_grid(~sex) +
labs(title = "Distribución Cardiopatía (Y/N)", x="Cardiopatía", y= "Recuento")
g14
# Grupo de edad (age_group)
summary(heart$age_group)
## Joven Adulto Mayor
## 0 37 28
g15<-ggplot(data=heart, aes(x=age_group))+
geom_bar(aes(fill=age_group))+
facet_grid(~sex) +
labs(title = "Distribución de los grupos de edad", x="Grupo de edad", y= "Recuento")
g15
#Visualizamos los resultados en una matriz de correlaciones, incluyendo todas las variables numéricas
library(ggcorrplot)
df2 <- heart[c(14, 1,4,5, 8, 10, 12)]
corr <- cor(round(df2, 2))
corr_chart<-ggcorrplot(corr ,hc.order=TRUE,lab=FALSE)
corr_chart
# Hacemos cópia de los datos antes de iniciar la limpieza
heart_ld<-heart
# Primero determinamos el número de valores vacíos o valores en blanco:
colSums(is.na(heart_ld))
## age sex cp trtbps chol fbs restecg thalachh
## 0 0 0 0 0 0 0 0
## exng oldpeak slp caa thall output age_group
## 0 0 0 0 0 0 0
colSums(heart_ld=="")
## age sex cp trtbps chol fbs restecg thalachh
## 0 0 0 0 0 0 0 0
## exng oldpeak slp caa thall output age_group
## 0 0 0 0 0 0 0
# Vemos como no hay ningun valor nulo en el conjunto de datos
# Estudiamos si hay valores que estén duplicados
sum(duplicated(heart_ld)) # Hay una fila que está repetida
## [1] 0
# Buscamos cual es la fila repetida
duplicated_rows <- duplicated(heart_ld)
duplicate_row <- heart_ld[duplicated_rows, ]
heart_ld <- unique(heart_ld) # Eliminamos la filas duplicada
sum(duplicated(heart_ld)) # Comprobamos como ahora no hay ninguna fila duplicada
## [1] 0
Seguidamente es importante estudiar la posibilidad de valores outliers para las variables númericas de la base de datos
# Para ello, creamos una función para que la podamos aplicar en cada uno de los atributos, de la cual obtengamos un gráfico Boxplot y una representación de puntos en forma de vector para poder visualizar mejor la posibilidad de valores outliers.
analisis_outliers <- function(variable, name){
# Creamos el gráfico
fig <- plot_ly(type = 'box')
# Representamos la variable
fig <- fig %>% add_boxplot(y = variable,
jitter = 0.3,
pointpos = -1.8,
boxpoints = 'all',
marker = list(color = 'rgb(47,79,79)'),
line = list(color = 'rgb(220,20,60)'),
fillcolor= list(color='rgb(220,20,60)'),
name = name)
fig <- fig %>% layout(title = paste("Análisis de valores Outliers de la variable", name))
# Obtenemos los posibles outliers:
outliers <- boxplot.stats(variable)$out
return(list(outliers=outliers, fig=fig))
}
# Age:
# Obtenemos la lista resultante de la función de análisis de outliers.
analisis = analisis_outliers(heart_ld$age,"Age")
# Representamos los datos con un gráfico BoxPlot
analisis$fig # No hay valores outliers
# Resting Blood Pressure (trtbps):
analisis = analisis_outliers(heart_ld$trtbps,"Resting Blood Pressure")
analisis$fig # Tampoco encontramos valores outliers, ya que, al filtrar con valores > 140, entendemos que todos los valores son posibles
# Cholesterol (chol):
analisis = analisis_outliers(heart_ld$chol,"Cholesterol")
analisis$fig
# Vemos que la distribución está centrada entre 126 y 400, por lo que no vemos ningún punto outlier.
# Maximum Heart Rate (thalachh)
analisis = analisis_outliers(heart_ld$thalachh,"Maximum Heart Rate")
analisis$fig #No se observan valores outliers
# Oldpeak (oldpeak)
analisis = analisis_outliers(heart_ld$oldpeak,"Oldpeak")
analisis$fig #Hay puntos que podrían ser valores outliers
# Visualizamos los valores candidatos a outliers
analisis$outliers
## [1] 6.2
# Vemos como es posible que se den estos valores, por lo que no hacemos ninguna acción en la variable
# Mostramos el resumen de los datos después de haber limpiado todo el conjunto
str(heart_ld)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 2 1 2 1 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 3 4 4 1 3 2 3 3 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 2 1 2 1 1 2 1 2 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 2 2 2 2 1 ...
## $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ exng : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 2 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
## $ slp : Factor w/ 3 levels "0","1","2": 1 3 3 3 1 3 2 3 3 1 ...
## $ caa : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
## $ thall : Factor w/ 4 levels "0","1","2","3": 2 4 3 3 3 3 3 3 3 3 ...
## $ output : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
# Vemos como ahora tenemos 15 atributos y hemos cambiado a tener 65 observaciones
summary(heart_ld)
## age sex cp trtbps chol fbs restecg
## Min. :40.00 0:22 0:33 Min. :142 Min. :126.0 0:50 0:38
## 1st Qu.:56.00 1:43 1: 5 1st Qu.:150 1st Qu.:225.0 1:15 1:26
## Median :59.00 2:16 Median :152 Median :244.0 2: 1
## Mean :59.25 3:11 Mean :157 Mean :249.9
## 3rd Qu.:65.00 3rd Qu.:160 3rd Qu.:282.0
## Max. :71.00 Max. :200 Max. :407.0
## thalachh exng oldpeak slp caa thall
## Min. : 88.0 0:41 Min. :0.000 0: 8 Min. :0.0000 0: 0
## 1st Qu.:128.0 1:24 1st Qu.:0.200 1:33 1st Qu.:0.0000 1: 7
## Median :147.0 Median :1.000 2:24 Median :0.0000 2:25
## Mean :144.3 Mean :1.392 Mean :0.8308 3:33
## 3rd Qu.:161.0 3rd Qu.:2.300 3rd Qu.:2.0000
## Max. :195.0 Max. :6.200 Max. :3.0000
## output age_group
## Min. :0.0000 Joven : 0
## 1st Qu.:0.0000 Adulto:37
## Median :0.0000 Mayor :28
## Mean :0.4154
## 3rd Qu.:1.0000
## Max. :1.0000
#Volvemos a visualizar los datos en conjunto como al inicio, pero con los datos limpios
#Edad
summary(heart_ld$age)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 40.00 56.00 59.00 59.25 65.00 71.00
g1<-ggplot(data=heart_ld, aes(x=age))+
geom_density(color="darkblue", fill="blue") +
labs(title = "Edad de los pacientes", x="Edad", y= "Densidad")
g1
#Sexo
summary(heart_ld$sex)
## 0 1
## 22 43
g2<-ggplot(data=heart_ld, aes(x=sex))+
geom_bar(mapping = aes(x=sex, fill=sex)) +
labs(title = "Sexo de los pacientes", x="Sexo", y= "Recuento")
g2
#Dolor Torácico (cp)
summary(heart_ld$cp)
## 0 1 2 3
## 33 5 16 11
g3<-ggplot(data=heart_ld, aes(x=cp))+
geom_bar(aes(fill=cp)) +
facet_grid(~sex) +
labs(title = "Distribución del Dolor Torácico", x="Dolor Torácico", y= "Recuento") + theme_classic()
g3
#Presión Arterial en Reposo (trtbps)
summary(heart_ld$trtbps)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 142 150 152 157 160 200
g4<-ggplot(data=heart_ld, aes(x=trtbps))+
geom_histogram(color="darkblue", fill="green") +
facet_grid(~sex) +
labs(title = "Distribución de la Presión Arterial en Reposo", x="Presión Arterial en Reposo (mm Hg)", y= "Recuento")
g4
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Colesterol Sérico (chol)
summary(heart_ld$chol)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 126.0 225.0 244.0 249.9 282.0 407.0
g5<-ggplot(data=heart_ld, aes(x=chol))+
geom_histogram(color="darkblue", fill="yellow") +
facet_grid(~sex) +
labs(title = "Distribución del Colesterol Sérico", x="Colesterol Sérico (mm/dl)", y= "Recuento")
g5
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Glucemia en ayunas (fbs)
summary(heart_ld$fbs)
## 0 1
## 50 15
g6<-ggplot(data=heart_ld, aes(x=fbs))+
geom_bar(fill="maroon4") +
facet_grid(~sex) +
labs(title = "Distribución Glucemia en ayunas > 120", x="Glucemia en Ayunas", y= "Recuento")
g6
# Electrocardiograma en Reposo (restecg)
summary(heart_ld$restecg)
## 0 1 2
## 38 26 1
g7<-ggplot(data=heart_ld, aes(x=restecg))+
geom_bar(aes(fill=restecg)) +
facet_grid(~sex) +
labs(title = "Distribución ECG en Reposo", x="ECG en Reposo", y= "Recuento")
g7
#Frecuencia Cardíaca Máxima (thalachh)
summary(heart_ld$thalachh)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 88.0 128.0 147.0 144.3 161.0 195.0
g8<-ggplot(data=heart_ld, aes(x=thalachh))+
geom_density(color="darkblue", fill="brown") +
facet_grid(~sex) +
labs(title = "Distribución Frecuencia Cardíaca Máxima alcanzada", x="Frecuencia Cardíaca Máxima", y= "Densidad")
g8
#Angina de Esfuerzo (exng)
summary(heart_ld$exng)
## 0 1
## 41 24
g9<-ggplot(data=heart_ld, aes(x=exng))+
geom_bar(aes(fill=exng)) +
facet_grid(~sex) +
labs(title = "Distribución Anginas Inducidas por Esfuerzo", x="Angina Inducida por Esfuerzo", y= "Recuento")
g9
#Antiguo pico (oldpeak)
summary(heart_ld$oldpeak)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.200 1.000 1.392 2.300 6.200
g10<-ggplot(data=heart_ld, aes(x=oldpeak))+
geom_histogram(color="black", fill="turquoise") +
facet_grid(~sex) +
labs(title = "Distribución Valor Medido en Depresión", x="Valor", y= "Recuento")
g10
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Pendiente del Segmento ST máximo (slp)
summary(heart_ld$slp)
## 0 1 2
## 8 33 24
g11<-ggplot(data=heart_ld, aes(x=slp))+
geom_bar(aes(fill=slp))+
facet_grid(~sex) +
labs(title = "Distribución Pendiente ST", x="Pendiente ST", y= "Recuento")
g11
# Número de grandes buques (caa)
summary(heart_ld$caa)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.8308 2.0000 3.0000
g12<-ggplot(data=heart_ld, aes(x=caa))+
geom_bar(fill="forestgreen")+
facet_grid(~sex) +
labs(title = "Distribución del Número de Buques", x="Nº de buques", y= "Recuento")
g12
# Tasa de Mortalidad (thall)
summary(heart_ld$thall)
## 0 1 2 3
## 0 7 25 33
g13<-ggplot(data=heart_ld, aes(x=thall))+
geom_bar(aes(fill=thall))+
facet_grid(~sex) +
labs(title = "Distribución de la Tasa de Mortalidad", x="Tasa de mortalidad", y= "Recuento")
g13
#Variable Cardiopatía (output)
summary(heart_ld$output)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.4154 1.0000 1.0000
g14<-ggplot(data=heart_ld, aes(x=output))+
geom_bar(fill="purple")+
facet_grid(~sex) +
labs(title = "Distribución Cardiopatía (Y/N)", x="Cardiopatía", y= "Recuento")
g14
# Grupo de edad (age_group)
summary(heart_ld$age_group)
## Joven Adulto Mayor
## 0 37 28
g15<-ggplot(data=heart_ld, aes(x=age_group))+
geom_bar(aes(fill=age_group))+
facet_grid(~sex) +
labs(title = "Distribución de los grupos de edad", x="Grupo de edad", y= "Recuento")
g15
#Visualizamos los resultados en una matriz de correlaciones, incluyendo todas las variables
library(ggcorrplot)
df2 <- heart_ld[c(14, 1,4,5, 8, 10, 12)]
corr <- cor(round(df2, 2))
corr_chart<-ggcorrplot(corr ,hc.order=TRUE,lab=FALSE)
corr_chart
(p.ej., si se van a comparar grupos de datos, ¿cuáles son estos grupos yqué tipo de análisis se van a aplicar?)
# De la misma manera que en la limpieza de los datos, creamos una cópia para trabajar la discretización de las variables
heart_discr<-heart_ld
# A continuación iniciamos el proceso de discretización de las variables para poder realizar correctamente los análisis posteriormente:
# Age
heart_discr["age"] <- cut(heart_discr$age, breaks=c(-Inf, 40,65,+Inf),
labels=c("Adulto","Mediana edad","Tercera edad"))
# Comprobamos como quedan los datos:
summary(heart_discr$age)
## Adulto Mediana edad Tercera edad
## 1 49 15
#Resting Blood Pressure
heart_discr["trtbps"] <- cut(heart_discr$trtbps, breaks=c(-Inf, 120, 140,+Inf),
labels=c("Normal","Alta","Muy Alta"))
# Comprobamos como quedan los datos:
summary(heart_discr$trtbps)
## Normal Alta Muy Alta
## 0 0 65
# Cholesterol
heart_discr["chol"] <- cut(heart_discr$chol, breaks=c(-Inf, 200, 240,+Inf),
labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos:
summary(heart_discr$chol)
## Normal Alto Muy Alto
## 9 20 36
# Maximum Rate Freq
heart_discr["thalachh"] <- cut(heart_discr$thalachh, breaks=c(-Inf, 120, 160,+Inf),
labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos:
summary(heart_discr$thalachh)
## Normal Alto Muy Alto
## 12 36 17
# Oldpeak
heart_discr["oldpeak"] <- cut(heart_discr$oldpeak, breaks=c(-Inf, 2, 2.55, +Inf),
labels=c("Normal","Alto","Muy Alto"))
#Comprobamos como quedan los datos:
summary(heart_discr$oldpeak)
## Normal Alto Muy Alto
## 48 2 15
Mediante la creación de una matriz de correlaciones, procederemos a estudiar la relación que hay entre cada uno de los atributos del conjunto de datos, mediante los datos limpios sin la discretización (heart_ld) y convertimos aquellas variables categóricas en númericas
#Creamos una cópia de los datos limpios sin discretizar para convertirlos todos en numéricos, y teniendo en cuenta la información aportada en la descripción de las variables
heart_cor <-heart_ld
str(heart_cor)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 2 1 2 1 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 3 4 4 1 3 2 3 3 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 2 1 2 1 1 2 1 2 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 2 2 2 2 1 ...
## $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ exng : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 2 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
## $ slp : Factor w/ 3 levels "0","1","2": 1 3 3 3 1 3 2 3 3 1 ...
## $ caa : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
## $ thall : Factor w/ 4 levels "0","1","2","3": 2 4 3 3 3 3 3 3 3 3 ...
## $ output : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
# sex
heart_cor$sex <- as.numeric(as.character(heart_cor$sex))
# cp
heart_cor$cp <- as.numeric(as.character(heart_cor$cp))
# fbs
heart_cor$fbs <- as.numeric(as.character(heart_cor$fbs))
# restecg
heart_cor$restecg <- as.numeric(as.character(heart_cor$restecg))
# exng
heart_cor$exng <- as.numeric(as.character(heart_cor$exng))
# slp
heart_cor$slp <- as.numeric(as.character(heart_cor$slp))
# thall
heart_cor$thall <- as.numeric(as.character(heart_cor$thall))
#Imprimimos la estructura de este nuevo dataset para ver como han sido transformadas las variables
str(heart_cor)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ sex : num [1:65] 1 1 1 0 0 1 1 0 1 0 ...
## $ cp : num [1:65] 3 2 2 3 3 0 2 1 2 2 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ fbs : num [1:65] 1 1 0 1 0 0 1 0 1 0 ...
## $ restecg : num [1:65] 0 1 1 0 1 1 1 1 1 0 ...
## $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ exng : num [1:65] 0 0 0 0 0 0 1 0 0 1 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
## $ slp : num [1:65] 0 2 2 2 0 2 1 2 2 0 ...
## $ caa : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
## $ thall : num [1:65] 1 3 2 2 2 2 2 2 2 2 ...
## $ output : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
#Vemos que ahora todos los atributos son numéricos, por lo que podemos crear la matriz de correlaciones.
#Hacemos el calculo de la matriz
# Primero quitamos la variable del grupo de edad
heart_cor <- heart_cor[, -15]
corr <- round(cor(heart_cor), 1)
#Realizamos la representación gráfic con los resultados
col <- colorRampPalette(c("#0000CD", "#7D26CD", "#FFFFFF",
"#FF6347","#FF0000"))
corrplot(corr, method = "square", shade.col = NA, tl.col = "black",
tl.srt = 45, col = col(200), addCoef.col = "black", order = "AOE",
type = "upper", diag = F, addshade = "all")
Viendo la matriz de correlaciones y las complementarias gráficas que
hemos ido viendo a lo largo del análisis, podemos confirmar que existe
una clara relación entre las variables incluidas en el conjunto de datos
y el hecho de padecer una enfermedad cardiovascular. De la misma manera,
vemos cuales son las diferentes relaciones entre las variables y la
manera en que podemos reducir el riesgo de padecder la enfermedad, hecho
que podemos estudiar con el método de componentes principales (PCA) y el
método de Descomposición de Valores Singulares (SDV) a continuación.